home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / SEARCH / RUBICON / RBCOMPAR.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-21  |  4KB  |  159 lines
  1. {*********************************************************}
  2. {*            RBCOMPAR.PAS 1.20             *}
  3. {*      Copyright (c) Tamarack Associates 1996.     *}
  4. {*           All rights reserved.          *}
  5. {*********************************************************}
  6.  
  7. {$B-}     {* Boolean evaluation *}
  8. {$G+}     {* Generate 286 code  *}
  9. {$X+}     {* eXtended syntax    *}
  10.  
  11. unit rbCompar;
  12.  
  13. interface
  14.  
  15. uses
  16.   {$IFDEF WIN32}
  17.   Windows,
  18.   {$ELSE}
  19.   WinTypes, WinProcs,
  20.   {$ENDIF}
  21.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  22.   StdCtrls, DB, DBTables, Grids, DBGrids, ExtCtrls,
  23.   StBase, taTools, taRubicn;
  24.  
  25. type
  26.   TForm1 = class(TForm)
  27.     MakeDictionary1: TMakeDictionary;
  28.     MakeDictionary2: TMakeDictionary;
  29.     Table1: TTable;
  30.     Table2: TTable;
  31.     DataSource1: TDataSource;
  32.     DataSource2: TDataSource;
  33.     DBGrid1: TDBGrid;
  34.     DBGrid2: TDBGrid;
  35.     Panel1: TPanel;
  36.     Label1: TLabel;
  37.     Label2: TLabel;
  38.     Edit1: TEdit;
  39.     Edit2: TEdit;
  40.     RecNoLabel: TLabel;
  41.     CompareBtn: TButton;
  42.     procedure CompareBtnClick(Sender: TObject);
  43.     procedure Edit1Exit(Sender: TObject);
  44.     procedure Edit2Exit(Sender: TObject);
  45.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  46.   private
  47.     { Private declarations }
  48.     FClosing  : BOOLEAN;
  49.     FContinue : WORD;
  50.   public
  51.     { Public declarations }
  52.     PROCEDURE Process;
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. procedure TForm1.Edit1Exit(Sender: TObject);
  63. begin
  64.  IF FClosing THEN EXIT;
  65.  WITH Table1 DO
  66.   BEGIN
  67.    Close;
  68.    TableName := AliasToPath(Edit1.Text);
  69.    Open;
  70.    IF NOT CheckStructure(Table1) THEN
  71.     BEGIN
  72.      Close;
  73.      RAISE EDictionary.Create('Invalid WordsTable structure')
  74.     END
  75.   END
  76. end;
  77.  
  78. procedure TForm1.Edit2Exit(Sender: TObject);
  79. begin
  80.  IF FClosing THEN EXIT;
  81.  WITH Table2 DO
  82.   BEGIN
  83.    Close;
  84.    TableName := AliasToPath(Edit2.Text);
  85.    Open;
  86.    IF NOT CheckStructure(Table2) THEN
  87.     BEGIN
  88.      Close;
  89.      RAISE EDictionary.Create('Invalid WordsTable structure')
  90.     END
  91.   END
  92. end;
  93.  
  94. procedure TForm1.CompareBtnClick(Sender: TObject);
  95. begin
  96.  WITH CompareBtn DO
  97.   IF Caption = 'Compare' THEN
  98.    TRY
  99.     Caption := 'Stop';
  100.     Process;
  101.    FINALLY
  102.     Caption := 'Compare'
  103.    END
  104.   ELSE FContinue := mrCancel
  105. end;
  106.  
  107. PROCEDURE TForm1.Process;
  108. VAR      RecNum   : LONGINT;
  109.       V1,V2    : TVerifyRecord;
  110.       B1,B2    : TtaBits;
  111.       P1,P2    : POINTER;
  112. BEGIN
  113.  IF NOT Table1.Active OR NOT Table2.Active THEN EXIT;
  114.  RecNum := 0;
  115.  FContinue := mrOk;
  116.  Table1.First;
  117.  Table2.First;
  118.  WHILE NOT Table1.EOF AND NOT Table2.EOF AND (FContinue = mrOk) DO
  119.   BEGIN
  120.    INC(RecNum);
  121.    RecNoLabel.Caption := IntToStr(RecNum);
  122.    Application.ProcessMessages;
  123.    MakeDictionary1.VerifyRecord(V1);
  124.    MakeDictionary2.VerifyRecord(V2);
  125.    B1 := TtaBits(V1.CompressedSize);
  126.    B2 := TtaBits(V2.CompressedSize);
  127.    P1 := POINTER(V1.Buffer);
  128.    P2 := POINTER(V2.Buffer);
  129.    IF Table1.Fields[wtWord].AsString <> Table2.Fields[wtWord].AsString THEN
  130.     FContinue := MessageDlg('Words differ',mtError,[mbOk,mbCancel],0);
  131.    IF (FContinue = mrOk) AND
  132.       (Table1.Fields[wtWordCount].AsInteger <> Table2.Fields[wtWordCount].AsInteger) THEN
  133.     FContinue := MessageDlg('WordCounts differ',mtError,[mbOk,mbCancel],0);
  134.    IF (FContinue = mrOk) AND
  135.       (Table1.Fields[wtBlobSize].AsInteger <> Table2.Fields[wtBlobSize].AsInteger) THEN
  136.     FContinue := MessageDlg('BlobSizes differ',mtError,[mbOk,mbCancel],0);
  137.    IF (FContinue = mrOk) AND (B1.Count <> B2.Count) THEN
  138.     FContinue := MessageDlg('Counts differ (' + IntToStr(B1.Count) + ':' +
  139.                IntToStr(B2.Count) + ')', mtError,[mbOk,mbCancel],0);
  140.    IF (FContinue = mrOk) AND (B1.FirstSet <> B2.FirstSet) THEN
  141.     FContinue := MessageDlg('FirstSets differ (' + IntToStr(B1.FirstSet) + ':' +
  142.                IntToStr(B2.FirstSet) + ')', mtError,[mbOk,mbCancel],0);
  143.    IF (FContinue = mrOk) AND (B1.LastSet <> B2.LastSet) THEN
  144.     FContinue := MessageDlg('LastSets differ (' + IntToStr(B1.LastSet) + ':' +
  145.                IntToStr(B2.LastSet) + ')', mtError,[mbOk,mbCancel],0);
  146.    IF (FContinue = mrOk) AND (B1.CompareBits(B2) <> 0) THEN
  147.     FContinue := MessageDlg('Bitsets differ',mtError,[mbOk,mbCancel],0);
  148.    Table1.Next;
  149.    Table2.Next;
  150.   END
  151. END;
  152.  
  153. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  154. begin
  155.  FClosing := TRUE
  156. end;
  157.  
  158. end.
  159.